home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 012a / lib194.zip / FRPG.PRG < prev    next >
Text File  |  1992-12-23  |  17KB  |  419 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: FRPG.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 09/28/1992
  5. *-- Notes.....: These are Fantasy Role-Playing Game routines. For examples of 
  6. *--             the use of these routines, in much detail, I have a gaming
  7. *--             system (constantly being modified) that uses these routines 
  8. *--             extensively. It's a fantasy system, based in 'Middle Earth'. 
  9. *--             It includes: Character Generation (updating, printing, deleting);
  10. *--             Random Encounters (Wilderness and City); and Random Treasure 
  11. *--             Generation. If interested, contact me. Information is in 
  12. *--             README.TXT. This system is not yet ready for 'public
  13. *--             consumption' ... eventually >sigh<.
  14. *-------------------------------------------------------------------------------
  15.  
  16. PROCEDURE SetRand
  17. *-------------------------------------------------------------------------------
  18. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  19. *-- Date........: 02/18/1992
  20. *-- Notes.......: A small procedure used to set a random number table. Used with
  21. *--               DICE(), etc. below, it can be quite handy. NOTE: You should
  22. *--               use EITHER this routine, OR  RAND(-1) (built in to dBASE).
  23. *-- Written for.: dBASE IV, 1.1
  24. *-- Rev. History: None
  25. *-- Calls.......: None
  26. *-- Called by...: Any
  27. *-- Usage.......: Do SetRand
  28. *-- Example.....: Do SetRand
  29. *-- Returns.....: None
  30. *-- Parameters..: None
  31. *-------------------------------------------------------------------------------
  32.  
  33.     private x,nSeed
  34.     nSeed = (val(substr(time(),1,2)) + val(substr(time(),4,2))+;
  35.                val(substr(time(),7,2))) * val(substr(time(),7,2))
  36.     x=int(rand(nSeed) * 6) + 1
  37.  
  38. RETURN
  39. *-- EoP: SetRand
  40.  
  41. FUNCTION Dice
  42. *-------------------------------------------------------------------------------
  43. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  44. *-- Date........: 02/13/1992
  45. *-- Notes.......: A small function used to determine a random number from
  46. *--               1 to x. Used for gaming purposes.
  47. *-- Written for.: dBASE IV, 1.1
  48. *-- Rev. History: 05/23/1991 - original function.
  49. *--               02/13/1992 -- Ken Mayer -- discovered after playing with this
  50. *--                that there are some problems with resetting the random table
  51. *--                each time. This has been removed. It also means that a 
  52. *--                couple of routines that used to be based on this can use
  53. *--                it better (see: MULTDICE() below ...)
  54. *-- Calls.......: None
  55. *-- Called by...: Any
  56. *--               MULTDICE()       Function in FRPG.PRG
  57. *-- Usage.......: Dice(<nSides>)
  58. *-- Example.....: nVal = Dice(4)
  59. *-- Returns.....: Random # between 1 and <nSides>
  60. *-- Parameters..: nSides = # of sides of die to be cast ... (RPG dice
  61. *--                        include 4, 6 (standard), 8, 10, 12, 20, 100 ...
  62. *-------------------------------------------------------------------------------
  63.  
  64.     parameters nSides
  65.  
  66.    *-- return a random number from 0 to nSides -1 and add 1 to it ...
  67. RETURN int(rand() * nSides) + 1
  68. *-- EoF: Dice()
  69.  
  70. FUNCTION MultDice
  71. *-------------------------------------------------------------------------------
  72. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  73. *-- Date........: 02/13/1992
  74. *-- Notes.......: Function like above, used to determine a random #,
  75. *--               but for multiple dice, of x# of sides.
  76. *-- Written for.: dBASE IV, 1.1
  77. *-- Rev. History: 06/12/1991 - original function.
  78. *--               02/13/1992 -- cleaned up to call DICE() above for each
  79. *--                iteration, rather than calling once and then redoing the
  80. *--                randomizer logic ... I was setting the random table
  81. *--                in the DICE() function, but decided it was more trouble
  82. *--                than it was worth ... resetting it too fast (i.e., in a loop)
  83. *--                and I was getting the exact same number 2 to 4 times in a
  84. *--                row ... not worth it. SO, I don't anymore.
  85. *-- Calls.......: DICE()               Function in FRPG.PRG
  86. *-- Called by...: Any
  87. *-- Usage.......: MultDice(<nNum>,<nSides>)
  88. *-- Example.....: nVal = MultDice(3,6)
  89. *-- Returns.....: Random value of 1 to x (x being number of sides), 
  90. *--               for each iteration (nNum), totalled. For example,
  91. *--               value returned would be the total of 3 six-sided die
  92. *--               rolled, the number would be anywhere from 3 to 18.
  93. *-- Parameters..: nNum   = Number of dice to be "rolled"
  94. *--               nSides = # of sides to the dice (see Dice() above)
  95. *-------------------------------------------------------------------------------
  96.  
  97.     parameters nNum,nSides
  98.     private nCount,nTotal
  99.     
  100.     nCount = 0                             && set counter
  101.     nTotal = 0                             && set total
  102.     do while nCount < nNum                 && loop for number of dice 
  103.         nCount = nCount + 1                 && increment counter
  104.         nTotal = nTotal + dice(nSides)      && add to total
  105.     enddo
  106.     
  107. RETURN nTotal
  108. *-- EoF: MultDice()
  109.  
  110. FUNCTION ValiDice
  111. *-------------------------------------------------------------------------------
  112. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  113. *-- Date........: 06/08/1992
  114. *-- Notes.......: Used to ask user for input of a number within a range
  115. *--               based on gaming dice. Programmer supplies # of dice,
  116. *--               and number of sides to function, it returns the input
  117. *--               from the user (and only allows valid input).
  118. *-- Written for.: dBASE IV, 1.1
  119. *-- Rev. History: 07/09/1991 - original function.
  120. *--               02/13/1992 -- modified to handle user pressing <Esc>.
  121. *--               06/08/1992 -- explicit color handling
  122. *-- Calls.......: SHADOW               Procedure in PROC.PRG
  123. *--               CENTER               Procedure in PROC.PRG
  124. *-- Called by...: Any
  125. *-- Usage.......: ValiDice(<nNum>,<nDice>,"<cMessage>","<cColor>")
  126. *-- Example.....: replace STRENGTH with ValiDice(3,6,"Strength",;
  127. *--                                       "rg+/gb,w/n,rg+/gb")  && 3 6-sided
  128. *-- Returns.....: Valid user input
  129. *-- Parameters..: nNum     = Number of dice
  130. *--               nSides   = Number of sides
  131. *--               cMessage = Message for line 0
  132. *--               cColor   = Colors for window
  133. *-------------------------------------------------------------------------------
  134.  
  135.     PARAMETERS nNum, nDice, cMessage, cColor
  136.     private nUpper,nUser 
  137.     
  138.     save screen to sDice
  139.     activate screen
  140.     define window wDice from 8,20 to 14,60 double color &cColor
  141.     do shadow with 8,20,14,60
  142.     activate window wDice
  143.     
  144.     nUpper = nNum * nDice    && upper limit
  145.     do center with 0,40,"","&cMessage"
  146.     do center with 1,40,"","Enter a value from "+ltrim(str(nNum))+" to "+;
  147.                             ltrim(str(nUpper))
  148.     do center with 2,40,"","("+ltrim(str(nNum))+"d"+ltrim(str(nDice))+")"
  149.     nUser = 0
  150.     do while .t.
  151.         @4,18 get nUser picture "999" valid required nUser => nNum .and.;
  152.                                                  nUser =< nUpper;
  153.                              error chr(7)+"Enter a valid number!"
  154.         read 
  155.         if lastkey() = 27
  156.             ?? chr(7)
  157.         else
  158.             exit
  159.         endif
  160.     enddo
  161.  
  162.     deactivate window wDice
  163.     release window wDice
  164.     restore screen from sDice
  165.     release screen sDice
  166.     
  167. RETURN nUser
  168. *-- EoF: ValiDice()
  169.  
  170. FUNCTION DiceChoose
  171. *-------------------------------------------------------------------------------
  172. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  173. *-- Date........: 06/08/1992
  174. *-- Notes.......: This is another FRPG routine -- It is used to give the
  175. *--               user a choice of three die roles. The computer will
  176. *--               randomly generate a die roll three times so the user
  177. *--               has a choice. 
  178. *-- Written for.: dBASE IV, 1.1
  179. *-- Rev. History: 07/09/1991 - original function
  180. *--               02/13/1992 -- Modified to only require use of MULTDICE(),
  181. *--               not a call to DICE() AND MULTDICE() ... also modified to
  182. *--               deal with user pressing <Esc> (it beeps at 'em).
  183. *--               06/08/1992 -- Explicit color handling
  184. *-- Calls.......: MULTDICE()           Function in FRPG.PRG
  185. *--               SHADOW               Procedure in PROC.PRG
  186. *--               CENTER               Procedure in PROC.PRG
  187. *-- Called by...: Any
  188. *-- Usage.......: DiceChoose(<nNum>,<nSides>,"<nMessage>","<cColor>")
  189. *-- Example.....: replace STRENGTH with DiceChoose(3,6,;
  190. *--                                 "To determine your character's Strength",;
  191. *--                                 "rg+/gb,w+/n,rg+/gb")
  192. *-- Returns.....: The value of one of the choices displayed for the user,
  193. *--               which will be a value from nNum to nNum*nSides + nNum+nPlus.
  194. *-- Parameters..: nNum     = number of dice to be rolled
  195. *--               nSides   = number of sides for each dice
  196. *--               cMessage = Message to be displayed at line 0 (max 40 Char)
  197. *--               cColor   = Colors for the window
  198. *-------------------------------------------------------------------------------
  199.  
  200.     PARAMETERS nNum, nSides, cMessage, cColor
  201.     private nVal1,nVal2,nVal3,nUser
  202.     
  203.     *-- here we determine the three values for the user (roll the dice) --
  204.     nVal1 = multdice(nSides,nNum)
  205.     nVal2 = multdice(nSides,nNum)
  206.     nVal3 = multdice(nSides,nNum)
  207.     
  208.     *-- now we have the three values we need, define windows/menu ...
  209.     activate screen
  210.     define window wDice from 8,20 to 17,60 double color &cColor
  211.     save screen to sDice
  212.     define menu mDice                      && as it says, define the menu
  213.     define pad  pChoice1 of mDice prompt ltrim(str(nVal1)) at 3,18
  214.     define pad  pChoice2 of mDice prompt ltrim(str(nVal2)) at 4,18
  215.     define pad  pChoice3 of mDice prompt ltrim(str(nVal3)) at 5,18
  216.     on selection pad pChoice1 of mDice deactivate menu
  217.     on selection pad pChoice2 of mDice deactivate menu
  218.     on selection pad pChoice3 of mDice deactivate menu
  219.     
  220.     *-- activate it all for user ...
  221.     do shadow with 8,20,17,60              && display shadow
  222.     activate window wDice                  && startup the window
  223.     *-- display info in Window
  224.     do center with 0,40,"","&cMessage"
  225.     do center with 1,40,"","Choose a value from below:"
  226.     @3,15 say "1)"
  227.     @4,15 say "2)"
  228.     @5,15 say "3)"
  229.     do center with 7,40,"","Use Arrow keys, <Enter> to choose"
  230.     do while .t.
  231.         activate menu mDice                    && startup menu
  232.         if lastkey() = 27
  233.             ?? chr(7)
  234.         else
  235.             exit
  236.         endif
  237.     enddo
  238.     do case                                && determine value to be returned
  239.         case pad() = "PCHOICE1"
  240.             nUser = nVal1
  241.         case pad() = "PCHOICE2"
  242.             nUser = nVal2
  243.         case pad() = "PCHOICE3"
  244.             nUser = nVal3
  245.     endcase
  246.     
  247.     *-- cleanup
  248.     release menu mDice
  249.     deactivate window wDice
  250.     release window wDice
  251.     restore screen from sDice
  252.     release screen sDice
  253.     on escape
  254.     
  255. RETURN nUser
  256. *-- EoF: DiceChoose()
  257.  
  258. FUNCTION ParseDice
  259. *-------------------------------------------------------------------------------
  260. *-- Programmer...: Ken Mayer (CIS: 71333,1030)
  261. *-- Date.........: 02/13/1992
  262. *-- Notes........: This is another gaming function ...
  263. *--                It's purpose is to read a string in the format  xdy+z  or 
  264. *--                some variation, and calculate the value ... 
  265. *--                x = # of dice, 
  266. *--                d = a part of the standard gaming syntax (i.e., 3d6),
  267. *--                y = # of sides of dice,
  268. *--                + = a modifier (could be a minus also ...)
  269. *--                z = number to modify each die rolled
  270. *--                (3d6+1 = a value from 6 to 21 (figure if you add 1 to each 
  271. *--                 die rolled, minimum value will be 6 (3+3), maximum will 
  272. *--                 be 21 (18+3))).)
  273. *-- Written for.: dBASE IV, 1.1
  274. *-- Rev. History: 08/29/1991 - original function.
  275. *--               02/13/1992 -- minor -- changed randomizer call to DICE()
  276. *-- Calls.......: ALLTRIM()            Function in PROC.PRG
  277. *--               DICE()               Function in FRPG.PRG
  278. *-- Called by...: Any
  279. *-- Usage.......: ParseDice("<cDice>")
  280. *-- Example.....: ? ParseDice("5d6-3")
  281. *-- Returns.....: Random number from x (modified by z) to y (modified by z)
  282. *-- Parameters..: cDice = Standard gaming format value to be parsed and
  283. *--               calculated.
  284. *-------------------------------------------------------------------------------
  285.  
  286.     parameter cDice    && value to parse and return a # from ...
  287.     private nCount,cDice,nPos,nNumDice,nMod,nDice,nPos2,nReturn
  288.     
  289.     cDice = upper(alltrim(cDice)) && trim out ALL extra spaces on left and right,
  290.                                   && and convert to all caps (for check for 
  291.                                   && letter 'D')
  292.     
  293.     if at("D",cDice) > 0          && if the letter 'D' is in there ...
  294.         *-- get the VALUE of the "substring" of cDice, starting at
  295.         *-- character 1, going to the letter D and backing up 1.
  296.         *-- this will be useful in case we have 10dy ... otherwise,
  297.         *-- we _could_ assume only one character, but assumptions are
  298.         *-- bad ...
  299.         nPos = at("D",cDice)
  300.         nNumDice = val(substr(cDice,1,nPos-1))
  301.         nPos = nPos + 1  && move to character beyond letter 'D'
  302.         if at("+",cDice) > 0   && if we have a + modifier
  303.            nPos2 = at("+",cDice)
  304.             nDice = val(substr(cDice,nPos,nPos2-1))
  305.             nMod = val(substr(cDice,nPos2+1,len(cDice)-nPos2))
  306.         else
  307.             if at("-",cDice) > 0 && if we have a - modifier
  308.                 nPos2 = at("-",cDice)
  309.                 nDice = val(substr(cDice,nPos,nPos2-1))
  310.                 nMod = val(substr(cDice,nPos2+1,len(cDice)-nPos2))
  311.             else  && no modifier
  312.                 nDice = val(substr(cDice,nPos,len(cDice)-nPos+1))
  313.             endif  && check for - sign
  314.         endif  && check for + sign
  315.         
  316.         *-- roll the nDice sided "dice" nNumDice number of times ...
  317.         nCount = 0
  318.         nReturn = 0
  319.         do while nCount < nNumDice
  320.             nCount = nCount + 1
  321.             nReturn = nReturn + dice(nDice)
  322.         enddo
  323.         
  324.         *-- Modifiers -- add or subtract appropriate value
  325.         if at("+",cDice) > 0  && if there's a + sign,
  326.             nReturn = nReturn + (nNumDice * nMod)
  327.         endif
  328.         if at("-",cDice) > 0  && it's a minus sign
  329.             nReturn = nReturn - (nNumDice * nMod)
  330.         endif
  331.         
  332.     else   && there's no letter 'D', so we simply have a number to return
  333.            && this is under the assumption that the value passed is either
  334.            && a random one, or (in this case) it's a set value ... for
  335.            && example, in some cases in my gaming system, HitPoints for a
  336.            && critter may be a set value, in others it may be a random one.
  337.            && this routine handles both ...
  338.     
  339.         nReturn = val(cDice)
  340.         
  341.     endif
  342.  
  343. RETURN nReturn
  344. *-- EoF: ParseDice()
  345.  
  346. PROCEDURE PopDice
  347. *-------------------------------------------------------------------------------
  348. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  349. *-- Date........: 06/08/1992
  350. *-- Notes.......: Used in my FRPG system as a Gamemaster's aid ... I can simply
  351. *--               press <Alt>D and have the system popup a window over whatever
  352. *--               I'm doing, ask for a "dice string" as in PARSEDICE(), and have
  353. *--               it return a value. That way I'm not stuck digging for the
  354. *--               dice in the middle of a situation that calls for a quick roll.
  355. *-- Written for.: dBASE IV, 1.1
  356. *-- Rev. History: 06/08/1992 -- Explicit color handling ...
  357. *-- Calls.......: SHADOW               Procedure in PROC.PRG
  358. *--               CENTER               Procedure in PROC.PRG
  359. *--               PARSEDICE()          Function in FRPG.PRG
  360. *-- Called by...: Any
  361. *-- Usage.......: Do PopDice with <cColor>
  362. *-- Example.....: ON KEY LABEL ALT-D DO POPDICE WITH "RG+/GB,W+/N,RG+/GB"
  363. *-- Returns.....: None
  364. *-- Parameters..: cColor = window colors ...
  365. *-------------------------------------------------------------------------------
  366.     parameters cColor
  367.     private cDice,cCursor 
  368.  
  369.     *-- setup
  370.     cCursor = set("CURSOR")
  371.     set cursor off
  372.     save screen to sPop  && save the screen
  373.     
  374.     activate screen
  375.     define window wPop from 7,20 to 15,60 double color &cColor
  376.     do shadow with 7,20,15,60
  377.     activate window wPop
  378.     do center with 0,40,"","PopDice (c) 1992"
  379.     
  380.     *-- loop until user pressed such keys as <Enter> or <Esc> ...
  381.     do while .t.
  382.         store space(10) to cDice  && blank out field
  383.         @2,2 say "Enter dice description: " get cDice;
  384.             message "Examples: 6 (1d6), d6, 3d6, 3d6+1, 3d6-1 ..."
  385.         set cursor on
  386.         read
  387.         set cursor off
  388.         if len(trim(cDice)) = 0        && len ... = 0, time to close down ...
  389.             exit
  390.         endif
  391.         if at("D",upper(cDice)) = 0    && parsedice() requires xD at front ...
  392.             cDice = "1d"+cDice
  393.         endif
  394.         if upper(left(cDice,1)) = "D"  && must be at least 1 ...
  395.             cDice = "1" + cDice
  396.         endif
  397.         @4,7 say "   Dice Rolled: "+cDice   && display what's being done
  398.         @5,0 clear                     && clear out messages, etc.
  399.         do center with 6,40,"rg+/r",". . . Calculating . . ."
  400.         *-- do it ... and display it
  401.         @5,7 say "Value returned: "+ltrim(str(parsedice(cDice)))
  402.         @6,0 clear
  403.     
  404.     enddo
  405.     
  406.     *-- cleanup
  407.     deactivate window wPop
  408.     release window wPop
  409.     restore screen from sPop
  410.     release screen sPop
  411.     set cursor &cCursor
  412.     
  413. RETURN
  414. *-- EoP: PopDice
  415.  
  416. *-------------------------------------------------------------------------------
  417. *-- EoP: FRPG.PRG
  418. *-------------------------------------------------------------------------------
  419.